;TAI

(defun createNode (state parent level cost)
	"Cria nó com um tabuleiro, pai, nivel e custo"
	(cons state (cons parent (cons level (cons cost nil)))))

; set's e get's do Nó
(defun setState (node state)
	(setf (first node) state))

(defun setParent (node parent)
	(setf (second node) parent))
 
(defun setLevel (node level)
	(setf (third node) level))

(defun setCost (node cost)
	(setf (fourth node) cost))

(defun getState (node)
	(first node))

(defun getParent (node)
	(second node))

(defun getLevel (node)
	(third node))

(defun getCost (node)
	(fourth node))

;procura com retrocesso

(defstruct chessBoard
	(queens)
	(free)
	(cost))

(defun createBoard (tam)
	"Cria estrutura com array das positions das rainhas, array com custo de cada rainha e matriz dominio"
	(make-chessBoard :queens (createArray tam '-)
		:free (createMatrix tam 0)
		:cost (createArray tam 0)))

(defun createArray (tam init)
	(make-array (list tam)
		:initial-element init))

(defun createMatrix (tam init)
	(make-array (list tam tam)
		:initial-element init))

(defun printBoard (board)
	(format t "~% +")
	(do ((i 0 (1+ i)))
		((= i (array-dimension (chessBoard-queens board) 0)) 'ok)
		(format t "--")
	)
	(format t "-+~%")
	(do ((x 0 (1+ x)))
		((= x (array-dimension (chessBoard-queens board) 0)) 'ok)
		(format t " |")
		(do ((y 0 (1+ y)))
			((= y (array-dimension (chessBoard-queens board) 0)))
			(cond 
				((and (numberp (aref (chessBoard-queens board) y)) (= (aref (chessBoard-queens board) y) (1+ x))) (format t " Q"))
				(t (format t " -")))
		)
		(format t " |~%")
	)
	(format t " +")
	(do ((i 0 (1+ i)))
		((= i (array-dimension (chessBoard-queens board) 0)) 'ok)
		(format t "--")
	)
	(format t "-+~%~%")
)

(defun copyArray (array)
	"retorna novo array com dados do array do parametro"
	(let ((dim (array-dimensions array)))
		(adjust-array (make-array dim :displaced-to array) dim)
	)
)

(defun copyBoard (board)
	"retorna nova estrutura igual a board"
	(let ((aux (copy-chessBoard board)))
		(setf (chessBoard-queens aux) (copyArray (chessBoard-queens board)))
		(setf (chessBoard-free aux) (copyArray (chessBoard-free board)))
		(setf (chessBoard-cost aux) (copyArray (chessBoard-cost board)))
		aux
	)
)

(defun createChild (node queen position)
	"Cria um nó filho"
	(createNode (placeQueen (copyBoard (getState node)) queen position) node (1+ (getLevel node)) (1+ (getCost node)))
)

(defun placeQueen (board queen position)
	"coloca uma rainha numa posição, actualiza custos e dominio"
	(setf (aref (chessBoard-queens board) queen) (1+ position))
	(setf (aref (chessBoard-cost board) queen) (aref (chessBoard-free board) queen position))
	(setf (aref (chessBoard-free board) queen position) #\Q)
	(do ((x 0 (1+ x)))
		((= x (array-dimension (chessBoard-queens board) 0)))
		(do ((y 0 (1+ y)))
			((= y (array-dimension (chessBoard-queens board) 0)))
			(cond
				((and (= x queen) (numberp (aref (chessBoard-free board) x y)))
					(setf (aref (chessBoard-free board) x y) (1+ (aref (chessBoard-free board) x y))))
				((and (= y position) (not (= x queen)))
					(cond 
						((numberp (aref (chessBoard-free board) x y)) (setf (aref (chessBoard-free board) x y) (1+ (aref (chessBoard-free board) x y))))
						((char= (aref (chessBoard-free board) x y) #\Q) (setf (aref (chessBoard-cost board) x) (1+ (aref (chessBoard-cost board) x))))
					)
				)
				((and (= (abs (- x queen)) (abs (- y position))) (not (= (- x queen) 0)))
					(cond
						((numberp (aref (chessBoard-free board) x y)) (setf (aref (chessBoard-free board) x y) (1+ (aref (chessBoard-free board) x y))))
						((char= (aref (chessBoard-free board) x y) #\Q) (setf (aref (chessBoard-cost board) x) (1+ (aref (chessBoard-cost board) x))))
					)
				)
			)
		)
	)
	(format t "Place Queen ~A: ~A~%" (1+ queen) (1+ position))
	board
)

(defun generateSucessors(node)
	"Retorna lista de sucessores"
	(do ((x 0 (1+ x)))
		((= x (array-dimension (chessBoard-queens (getState node)) 0)) nil)
		(cond
			((not (numberp (aref (chessBoard-queens (getState node)) x))) (return (sucessor node x 0)))
		)
	))

(defun sucessor (node queen position)
	"Constroi uma lista de sucessores"
	(cond
		((= position (array-dimension (chessBoard-queens (getState node)) 0)) nil)
		((= (aref (chessBoard-free (getState node)) queen position) 0) (cons (createChild node queen position) (sucessor node queen (1+ position))))
		(t (sucessor node queen (1+ position)))
	)
)

(defun checkBoard (board)
	"verifica se o array de rainhas esta todo preenchido"
	(do ((x 0 (1+ x)))
		((= x (array-dimension (chessBoard-queens board) 0)) t)
		(cond
			((not (numberp (aref (chessBoard-queens board) x))) (return nil))
		)
	)
)

(defun play (n)
	"jogar com procura com retrocesso"
	(let ((result (backtrack (createNode (createBoard n) nil 0 0))))
		(if (not (null result)) (progn (printBoard (getState result)) (getState result))))
)

(defun backtrack (node)
	"procura recursiva com retrocesso"
	(cond 
		((checkBoard (getState node)) node)
		((not (null (getState node)))
			(let ((sucessors (generateSucessors node)))
				(loop for x in sucessors do
					(if (null x) t)
					(let ((next (createNode (getState x) (getParent x) (1+ (getLevel x)) (1+ (getCost x)))))
						(let ((solution (backtrack next)))
							(if (not (null solution)) (return solution))
						)
					)
				)
			)
		)
	)
)

;procura local

(defun randomQueens(board)
	"preenche o array de rainhas com posições aleatórias"
	(do ((x 0 (1+ x)))
		((= x (array-dimension (chessBoard-queens board) 0)) board)
		(let ((r (random (array-dimension (chessBoard-queens board) 0))))
			(placeQueen board x r))
	)
)

(defun fillQueens (queens)
	"coloca as rainhas nas posições do array queens"
	(let ((board (createBoard (array-dimension queens 0))))
		(do ((x 0 (1+ x)))
			((= x (array-dimension queens 0)) board)
			(placeQueen board x (1- (aref queens x)))
		)
	)
)

(defun getMin (matrix queen)
	"obtem a posição de menor custo para uma rainha"
	(let ((min (array-dimension matrix 1)))
		(do ((x 0 (1+ x)))
			((= x (array-dimension matrix 1)) min)
			(cond
				((numberp (aref matrix queen x)) (if (< (aref matrix queen x) min) (setf min (aref matrix queen x))))
			)
		)
	)
)

(defun getMax (array)
	"obtem rainha com mais custo"
	(let ((max 0))
		(do ((x 0 (1+ x)))
			((= x (array-dimension array 0)) max)
			(if (> (aref array x) max) (setf max (aref array x)))
		)
	)
)

(defun selectQueens (cost position)
	"constroi lista com rainhas com mais custo"
	(cond
		((= position (array-dimension cost 0)) nil)
		((= (aref cost position) (getMax cost)) (cons position (selectQueens cost (1+ position))))
		(t (selectQueens cost (1+ position)))
	)
)

(defun selectPositions (board queen iterator)
	"constroi lista com posições de menos custo para uma rainha"
	(cond
		((= iterator (array-dimension (chessBoard-free board) 1)) nil)
		((numberp (aref (chessBoard-free board) queen iterator))
			(cond
				((= (aref (chessBoard-free board) queen iterator) (getMin (chessBoard-free board) queen)) (cons iterator (selectPositions board queen (1+ iterator))))
				(t (selectPositions board queen (1+ iterator)))
			)
		)
		(t (selectPositions board queen (1+ iterator)))
	)
)

(defun generateSucessors2 (node)
	"gera sucessores para a procura local"
	(let ((queens (selectQueens (chessBoard-cost (getState node)) 0)))
		(generateSucessors2Aux node queens (selectPositions (getState node) (first queens) 0))
	)
)

(defun generateSucessors2Aux (node queens positions)
	"constroi lista de sucessores"
	(cond
		((null queens) nil)
		((null positions)
			(cond 
				((null (rest queens)) nil)
				(t (generateSucessors2Aux node (rest queens) (selectPositions (getState node) (second queens) 0)))
			)
		)
		(t (cons (createChild2 node (first queens) (first positions)) (generateSucessors2Aux node queens (rest positions))))
	)
)

(defun createChild2 (node queen position)
	"Cria nó filho"
	(let ((queens (copyArray (chessBoard-queens (getState node)))))
		(setf (aref queens queen) (1+ position))
		(createNode (fillQueens queens) node (1+ (getLevel node)) (1+ (getCost node)))
	)
)

(defun getSumOfCost (node)
	"retorna soma do array cost"
	(let ((cost 0))
		(do ((x 0 (1+ x)))
			((= x (array-dimension (chessBoard-cost (getState node)) 0)) cost)
			(setf cost (+ cost (aref (chessBoard-cost (getState node)) x)))
		)
	)
)

(defun chooseBetter (sucessors node)
	"retorna melhor sucessor de uma lista de nós sucessores"
	(cond
		((null sucessors) node)
		((checkNode (first sucessors)) (chooseBetter (rest sucessors) node))
		((> (getSumOfCost (first sucessors)) (getSumOfCost node)) (chooseBetter (rest sucessors) node))
		((<= (getSumOfCost (first sucessors)) (getSumOfCost node)) (chooseBetter (rest sucessors) (first sucessors)))
	)
)

(defun checkNode (node)
	"verifica se o node já foi avaliado"
	(checkNodeAux node (getParent node))
)

(defun checkNodeAux (node parent)
	"verifica se o node é igual ao parent"
	(cond
		((null parent) nil)
		((isEqual (getState node) (getState parent)) t)
		(t (checkNodeAux node (getParent parent)))
	)
)

(defun isEqual (board1 board2)
	"verifica se os tabuleiros são iguais"
	(equalp board1 board2)
)

(defun checkCost (node)
	"verifica se o custo é 0"
	(do ((x 0 (1+ x)))
		((= x (array-dimension (chessBoard-cost (getState node)) 0)) t)
		(cond
			((not (= (aref (chessBoard-cost (getState node)) x) 0)) (return nil))
		)
	)
)

(defun localSearch (node)
	"procura local"
	(cond
		((checkCost node) node)
		((not (null (getState node)))
			(let ((sucessors (generateSucessors2 node)))
				(let ((next (chooseBetter sucessors (first sucessors))))
					(localSearch next)
				)
			)
		)
	)
)

(defun play2 (n)
	"jogar com procura local"
	(if (or (= n 1) (> n 3))
		(let ((result (localSearch (createNode (randomQueens (createBoard n)) nil 0 0))))
			(if (not (null result)) (progn (printBoard (getState result)) (getState result))))
	)
)